home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
tan_snd.arc
/
FART.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-07-27
|
5KB
|
231 lines
{ FART.PAS - Demo of music and drum routines for Tandy 1000 and/or PCJr }
uses noiz,drums;
var j,k: integer;
procedure down(a,b,c: integer);
begin
drums.down(a,b,c);
quiet;
end;
procedure up(a,b,c: integer);
begin
drums.up(a,b,c);
quiet;
end;
procedure crash(dur: integer);
begin
up(1,14,1);
down(0,dur,1);
end;
procedure roll1;
var i: integer;
begin
for i:=1 to 4 do down(0,2,1);
for i:=1 to 4 do down(1,2,1);
for i:=1 to 4 do down(2,2,1);
for i:=1 to 4 do up(3,2,1);
down(0,20,1);
end;
procedure roll2;
var i: integer;
begin
for i:=1 to 4 do up(1,2,1);
for i:=1 to 4 do down(2,2,1);
for i:=1 to 4 do up(0,2,1);
for i:=1 to 4 do down(0,3,1);
up(0,20,1);
end;
procedure roll3;
var i: integer;
begin
bass(2,4);
lowtom(8,2); tom(8,2); snare(8,2);
bass(2,4);
snare(8,2); tom(8,2); lowtom(8,2);
bass(8,2);
down(0,20,1);
end;
procedure roll4;
begin
snare(8,2);
lowtom(4,4); lowtom(4,2);
tom(4,4); roto1(4,1);
end;
procedure filler(b: boolean);
begin
sound(e2); snare(2,8);
sound(g2); snare(2,6);
sound(a3); snare(4,2);
sound(as2); lowtom(4,4);
sound(b2); lowtom(4,2);
sound(d2); tom(4,4);
sound(b2); bass(4,2);
sound(d2); snare(2,5);
bend(d2,e2,40,12,1);
if b then
begin
sound(e2);
chord(e3,b3,e4,6,12);
nosound;
snare(2,2);
end else
snare(2,2);
end;
procedure lick1(reps,dur: integer);
const
eblues: array[1..8] of integer =
(e3,fs3,g3,a4,as4,b4,d4,e4);
var i,j: integer;
begin
if (reps <= 0) then exit;
j:=1;
for i:=1 to reps do
begin
j:=1;
repeat
plays(eblues[j],dur,0,9,0);
inc(j);
until j=9;
bend(d4,e4,24,2,1);
plays(g4,20,10,0,0);
bend(e4,d4,24,2,1);
quiet;
end;
end;
procedure guitar_solo;
begin
sound(e2);
chord(e3,b3,e4,15,25); quiet;
scale2(e3,g3,a4,as4,b4,d4,ds4,e4,10,2,9,0);
crash(2); crash(5);
sound(as2);
chord(as4,f4,as5,15,25); quiet;
bend(d5,e5,40,0,3);
plays(e5,50,0,10,0);
scale2(g5,e5,d5,b5,g5,e5,d5,b5,25,5,0,0);
scale2(g5,e5,d5,b5,as5,a5,g4,e4,25,5,0,0);
bend(d5,e5,40,0,3); plays(g5,50,0,0,0);
bend(e5,d5,40,4,1); plays(b5,50,0,0,0);
bend(g5,a6,20,0,3);
scale2(b6,as6,a6,g5,b6,as6,a6,g5,10,10,0,0);
bend(d5,e5,20,5,1);
scale2(g5,e5,d5,b5,as5,a5,g4,e4,0,7,7,0);
crash(2); crash(6);
sound(e2);
echo(40,long);
chord(e3,b3,e4,1,30);
down(2,15,1);
end;
procedure ending;
begin
up(1,25,1);
sound(as2); chord(as4,f4,as5,27,25);
up(0,25,1);
sound(c2); chord(g3,c4,g4,27,10);
up(2,46,1);
sound(e1); chord(e3,b4,e4,27,15);
up(1,5,1); down(2,50,1); quiet; halt;
end;
procedure beat1(reps: integer);
var i,mode,counter: integer;
label tg;
begin
k:=0; mode:=0;
up(2,50,1); filler(true);
Tg:
case mode of
0:;
1: sound(e3);
2: sound(b3);
3: begin
sound(a2); mode:=0;
end;
end;
inc(mode);
down(2,8,1);
if (i = 2) then
begin
if (k in [12,16,20,24,28,32,36]) then
begin
case k of
12: begin
sound(g2);
chord(g2,c3,g4,1,12);
down(2,15,1);
end;
16: begin
sound(d2);
chord(d3,a4,c4,1,5);
down(2,15,1);
end;
20: begin
filler(false);
sound(e2);
chord(e3,b3,e4,1,12);
down(2,15,1);
end;
24: begin
sound(e2); lick1(1,12);
sound(e2);
chord(e3,b3,e4,1,30);
down(2,15,1);
end;
28: begin
sound(as2);
chord(as4,f4,as5,1,25);
down(2,15,1);
end;
32: guitar_solo;
36: begin
sound(as2);
chord(as4,f4,as5,1,25);
down(2,15,1);
k:=0;
end;
end;
end else
begin
nosound;
sound(e2);
chord(e3,b3,e4,1,12);
down(2,15,1);
end;
end;
j:=0; i:=0;
for counter:=1 to reps do
begin
if ((keyhit) and (fkey=#3)) then ending;
inc(i); inc(j); inc(k);
down(0,5,1);
wait(50);
if j=2 then
begin
up(1,5,1); j:=11; i:=0;
end;
if (i = 2) then goto tg;
down(0,3,1);
down(2,8,1);
down(2,8,1);
end;
roll1; crash(15);
end;
begin
drums.inturbo:=false; noiz.inturbo:=false;
roll3; roll2; roll1;
writeln('Hit Crtl-C to End');
beat1(8);
end.